home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_300 / 333_01 / awk3.c < prev    next >
Encoding:
C/C++ Source or Header  |  1989-04-21  |  31.3 KB  |  1,469 lines
  1. /* awk3.c -- Builtin functions and various utility procedures
  2.    Copyright (C) 1986,1987 Free  Software Foundation
  3.    Written by Jay Fenlason, December 1986
  4.  */
  5.  
  6. #include <stdio.h>
  7. #include <stdlib.h>
  8. #include <string.h>
  9. #include <math.h>
  10. #include <time.h>
  11. #include <errno.h>
  12. #include "awk.h"
  13.  
  14.  
  15.  
  16. struct redirect
  17. {
  18.     int         flag;      /* type of redirection */
  19.     NODE           *value;
  20.     FILE           *fp;
  21. };
  22. typedef struct redirect     REDIRECT;
  23.  
  24. static REDIRECT reds[20];    /* An arbitrary limit, surely, but there's an
  25.                  * arbitrary limit on open files, too.  So it
  26.                  * doesn't make much difference, does it? */
  27.  
  28.  
  29. long            NR;
  30. int             NF;
  31.  
  32. /* Set all the special variables to their initial values.  Also sets up
  33.    the dumb[] array for force_string */
  34.  
  35. VOID PASCAL init_vars(void)
  36. {
  37.     register int      i;
  38.     auto     NODE    **tmp;
  39.  
  40.     FS_node      = spc_var("FS", make_string("[\t ]+", 5));
  41.     NF_node      = spc_var("NF", make_number(0.0));
  42.     RS_node      = spc_var("RS", make_string("\n", 1));
  43.     NR_node      = spc_var("NR", make_number(0.0));
  44.     FILENAME_node = spc_var("FILENAME", Nnull_string);
  45.     OFS_node      = spc_var("OFS", make_string(" ", 1));
  46.     ORS_node      = spc_var("ORS", make_string("\n", 1));
  47.     OFMT_node      = spc_var("OFMT", make_string("%.6g", 4));
  48.     FNR_node      = spc_var("FNR", make_number(0.0));
  49.     RLENGTH_node  = spc_var("RLENGTH", make_number(0.0));
  50.     RSTART_node   = spc_var("RSTART", make_number(0.0));
  51.     SUBSEP_node   = spc_var("SUBSEP", make_string("\034", 1));
  52.     ARGC_node      = spc_var("ARGC", make_number(1.0));
  53.     ARGV_node      = variable("ARGV");
  54.     assoc_clear(ARGV_node);
  55.     tmp  = assoc_lookup(ARGV_node, tmp_number((AWKNUM) 0.0), ASSOC_CREATE);
  56.     *tmp = make_string(myname, strlen(myname));
  57.  
  58.     /* This ugly hack is used by force_string to fake a call to sprintf */
  59.     dumb[0].type  = NODE_EXPRESSION_LIST;
  60.     dumb[0].lnode = OFMT_node;
  61.     dumb[0].rnode = &dumb[1];
  62.     dumb[1].type  = NODE_EXPRESSION_LIST;
  63.     dumb[1].lnode = (NODE *) NULL; /* fill in the var here */
  64.     dumb[1].rnode = (NODE *) NULL;
  65.  
  66.     for (i = 0; i < MAXDIM(reds); ++i)
  67.     reds[i].flag = NODE_ILLEGAL;
  68.  
  69.     return;
  70. }
  71.  
  72.  
  73. /* OFMT is special because we don't dare use force_string on it for fear of
  74.    infinite loops.  Thus, if it isn't a string, we return the default "%.6g"
  75.    This may or may not be the right thing to do, but its the easiest */
  76. /* This routine isn't used!  It should be.  */
  77.  
  78. char * PASCAL get_ofmt(void)
  79. {
  80.     register NODE      *tmp;
  81.  
  82.     tmp = *get_lhs(OFMT_node);
  83.     if (tmp->type != NODE_STRING || tmp->stlen == 0)
  84.     return("%.6g");
  85.     return(tmp->stptr);
  86. }
  87.  
  88.  
  89. REPAT_BUFFER * PASCAL get_fs(void)
  90. {
  91.     register NODE        *tmp;
  92.     auto     char        *err;
  93.     auto     char        *str;
  94.     auto     int         len;
  95.     static   REPAT_BUFFER    fs_repat;
  96.     static   char         fs_fastmap[FASTMAP_SIZE];
  97.     static   char         fs_str[256] = "";
  98.  
  99.     tmp = force_string(FS_node->var_value);
  100.     if (0 == tmp->stlen)
  101.     {
  102.     str = "[\t ]+";
  103.     len = strlen(str);
  104.     }
  105.     else
  106.     {
  107.     str = tmp->stptr;
  108.     len = tmp->stlen;
  109.     }
  110.  
  111.     if (strcmp(str, fs_str))
  112.     {
  113.     strcpy(fs_str, str);
  114.     fs_repat.fastmap      = fs_fastmap;
  115.     fs_repat.used          = 0;
  116.     fs_repat.fastmap_accurate = FALSE;
  117.     fs_repat.can_be_null      = 0;
  118.     if (0 == fs_repat.allocated)
  119.     {
  120.         fs_repat.allocated = 100;
  121.         if (NULL == (fs_repat.buffer = malloc(100)))
  122.         panic("Out of memory for fs_repat buffer");
  123.     }
  124.     err = re_compile_pattern(str, len, &fs_repat);
  125.     if (err)
  126.         panic("Invalid REGEXP(%s) in FS variable: %s", str, err);
  127.     }
  128.  
  129.     return(&fs_repat);
  130. }
  131.  
  132.  
  133. VOID PASCAL set_fs(char *str)
  134. {
  135.     register NODE     **tmp;
  136.  
  137.     tmp = get_lhs(FS_node);
  138.     do_deref();
  139.  
  140.     *tmp = make_string(str, -1);
  141.     return;
  142. }
  143.  
  144.  
  145. VOID PASCAL set_rs(char *str)
  146. {
  147.     register NODE      **tmp;
  148.  
  149.     tmp = get_lhs(RS_node);
  150.     do_deref();
  151.  
  152.     if (*str == 't')
  153.     *str = '\t';
  154.  
  155.     *tmp = make_string(str, 1);
  156.     return;
  157. }
  158.  
  159.  
  160. int PASCAL get_rs(void)
  161. {
  162.     register NODE  *tmp;
  163.  
  164.     tmp = force_string(RS_node->var_value);
  165.     if (tmp->stlen == 0)
  166.     return('\n');
  167.     return(*(tmp->stptr));
  168. }
  169.  
  170.  
  171. /* Builtin functions */
  172.  
  173.  
  174. NODE * PASCAL do_match(NODE *tree)
  175. {
  176.     auto     int          idx;
  177.     auto     NODE         *str, *reg_node;
  178.     auto     char         *err;
  179.     auto     REPAT_BUFFER    *rp;
  180.     auto     REREGS          regs;
  181.  
  182.     get_two(tree, &str, ®_node);
  183.     str = force_string(str);
  184.     if (NODE_REGEXP == reg_node->type)
  185.     rp = reg_node->rereg;
  186.     else
  187.     {
  188.     reg_node = force_string(reg_node);
  189.     clear_wrk_repat();
  190.     rp  = &wrk_repat;
  191.     err = re_compile_pattern(reg_node->stptr, reg_node->stlen, rp);
  192.     if (err)
  193.         panic("Invalid REGEXP(%s) in match(): %s", reg_node->stptr, err);
  194.     }
  195.     idx = re_search(rp, str->stptr, str->stlen, 0, str->stlen, ®s);
  196.     if (idx < 0)
  197.     {
  198.     assign_number(&RSTART_node->var_value,    (AWKNUM) 0.0);
  199.     assign_number(&RLENGTH_node->var_value, (AWKNUM) 0.0);
  200.     idx = 0;
  201.     }
  202.     else
  203.     {
  204.     assign_number(&RSTART_node->var_value,    (AWKNUM) ++idx);
  205.     assign_number(&RLENGTH_node->var_value,
  206.               (AWKNUM) (regs.end[0] - regs.start[0]));
  207.     }
  208.     return(tmp_number((AWKNUM) idx));
  209. }
  210.  
  211.  
  212. NODE * PASCAL do_sub(NODE *tree)
  213. {
  214.     auto     int          idx, len;
  215.     auto     int          match_len;
  216.     auto     NODE         *regexp, *str1, *str2;
  217.     auto     char         *wrk, *pwrk;
  218.     auto     REPAT_BUFFER    *rp;
  219.     auto     REREGS          regs;
  220.  
  221.     get_three(tree, ®exp, &str1, &str2);
  222.     str1 = force_string(str1);
  223.     str2 = force_string(str2);
  224.     if (NODE_REGEXP == regexp->type)
  225.     rp = regexp->rereg;
  226.     else
  227.     {
  228.     regexp = force_string(regexp);
  229.     clear_wrk_repat();
  230.     rp  = &wrk_repat;
  231.     wrk = re_compile_pattern(regexp->stptr, regexp->stlen, rp);
  232.     if (wrk)
  233.         panic("Invalid REGEXP(%s) in sub(): %s", regexp->stptr, wrk);
  234.     }
  235.  
  236.     idx  = re_search(rp, str2->stptr, str2->stlen, 0, str2->stlen, ®s);
  237.     if (idx < 0)
  238.     return(tmp_number((AWKNUM) 0.0));
  239.  
  240.     match_len = regs.end[0] - regs.start[0];
  241.     wrk = malloc(str2->stlen - match_len + str1->stlen + 1);
  242.     if (NULL == wrk)
  243.     panic("Out of memory in do_sub()");
  244.  
  245.     pwrk = wrk;
  246.     if (idx > 0)
  247.     {
  248.     memcpy(pwrk, str2->stptr, idx);
  249.     pwrk += idx;
  250.     }
  251.     memcpy(pwrk, str1->stptr, str1->stlen);
  252.     pwrk += str1->stlen;
  253.     len = idx + match_len;
  254.     if (len < str2->stlen)
  255.     {
  256.     memcpy(pwrk, str2->stptr + len, str2->stlen - len);
  257.     pwrk += str2->stlen - len;
  258.     }
  259.     *pwrk = EOS;
  260.  
  261.     len  = str2->stlen - match_len + str1->stlen;
  262.     str1 = tree->rnode->rnode->lnode;
  263.     *get_lhs(str1) = dupnode(tmp_string(wrk, len));
  264.     do_deref();
  265.     free(wrk);
  266.  
  267.     /* If the modified string is a field variable we need to update the   */
  268.     /* value of the field variables.  If $0 was changed we need to recalc */
  269.     /* all the fields.    If an individual field was modified we need to      */
  270.     /* recalc $0. - BW 12/21/88                       */
  271.     if (NODE_FIELD_SPEC == str1->type)
  272.     field_spec_changed(str1->lnode->numbr);
  273.  
  274.     return(tmp_number((AWKNUM) 1.0));
  275. }
  276.  
  277.  
  278. NODE * PASCAL do_gsub(NODE *tree)
  279. {
  280.     auto     int           idx, len, strlen;
  281.     auto     int           match_len;
  282.     auto     int           hits = 0;
  283.     auto     int           ofs  = 0;
  284.     auto     NODE          *regexp, *str1, *str2;
  285.     auto     char          *cur2, *new2, *p;
  286.     auto     REPAT_BUFFER     *rp;
  287.     auto     REREGS           regs;
  288.  
  289.     get_three(tree, ®exp, &str1, &str2);
  290.     str1 = force_string(str1);
  291.     str2 = force_string(str2);
  292.     if (NODE_REGEXP == regexp->type)
  293.     rp = regexp->rereg;
  294.     else
  295.     {
  296.     regexp = force_string(regexp);
  297.     clear_wrk_repat();
  298.     rp = &wrk_repat;
  299.     p = re_compile_pattern(regexp->stptr, regexp->stlen, rp);
  300.     if (p)
  301.         panic("Invalid REGEXP(%s) in gsub(): %s", regexp->stptr, p);
  302.     }
  303.  
  304.     idx  = re_search(rp, str2->stptr, str2->stlen, 0, str2->stlen, ®s);
  305.     if (idx < 0)
  306.     return(tmp_number((AWKNUM) 0.0));
  307.  
  308.     match_len = regs.end[0] - regs.start[0];
  309.     strlen    = str2->stlen;
  310.     cur2      = malloc(strlen + 1);
  311.     if (NULL == cur2)
  312.     panic("Out of memory in gsub()");
  313.     strcpy(cur2, str2->stptr);
  314.  
  315.     do
  316.     {
  317.     p = new2 = malloc(strlen - match_len + str1->stlen + 1);
  318.     if (NULL == new2)
  319.         panic("Out of memory in gsub()");
  320.     if (idx > 0)
  321.     {
  322.         memcpy(p, cur2, idx);
  323.         p    += idx;
  324.         ofs += idx;
  325.     }
  326.     if (str1->stlen > 0)
  327.     {
  328.         memcpy(p, str1->stptr, str1->stlen);
  329.         p    += str1->stlen;
  330.         ofs += str1->stlen;
  331.     }
  332.     len = idx + match_len;
  333.     if (len < strlen)
  334.     {
  335.         memcpy(p, cur2 + len, strlen - len);
  336.         p += strlen - len;
  337.     }
  338.     *p = EOS;
  339.     free(cur2);
  340.     cur2   = new2;
  341.     strlen = strlen + str1->stlen - match_len;
  342.     ++hits;
  343.     if (ofs > strlen)
  344.         break;
  345.     idx = re_search(rp, cur2, strlen, ofs, strlen - ofs, ®s);
  346.     match_len = regs.end[0] - regs.start[0];
  347.     } while (idx > 0);
  348.  
  349.     str1 = tree->rnode->rnode->lnode;
  350.     *get_lhs(str1) = dupnode(tmp_string(cur2, strlen));
  351.     do_deref();
  352.     free(cur2);
  353.  
  354.     /* If the modified string is a field variable we need to update the   */
  355.     /* value of the field variables.  If $0 was changed we need to recalc */
  356.     /* all the fields.    If an individual field was modified we need to      */
  357.     /* recalc $0. - BW 12/21/88                       */
  358.     if (NODE_FIELD_SPEC == str1->type)
  359.     field_spec_changed(str1->lnode->numbr);
  360.  
  361.     return(tmp_number((AWKNUM) hits));
  362. }
  363.  
  364.  
  365. NODE * PASCAL do_exp(NODE *tree)
  366. {
  367.     auto     NODE      *tmp;
  368.  
  369.     get_one(tree, &tmp);
  370.     return(tmp_number(exp(force_number(tmp))));
  371. }
  372.  
  373.  
  374. NODE * PASCAL do_cos(NODE *tree)
  375. {
  376.     auto     NODE    *tmp;
  377.  
  378.     get_one(tree, &tmp);
  379.     return(tmp_number(cos(force_number(tmp))));
  380. }
  381.  
  382.  
  383. NODE * PASCAL do_sin(NODE *tree)
  384. {
  385.     auto     NODE    *tmp;
  386.  
  387.     get_one(tree, &tmp);
  388.     return(tmp_number(sin(force_number(tmp))));
  389. }
  390.  
  391.  
  392. NODE * PASCAL do_atan2(NODE *tree)
  393. {
  394.     auto     NODE    *tmp1, *tmp2;
  395.  
  396.     get_two(tree, &tmp1, &tmp2);
  397.     return(tmp_number(atan2(force_number(tmp1), force_number(tmp2))));
  398. }
  399.  
  400.  
  401. /* JF: I don't know what this should return. */
  402. /* jfw: 1 if successful or by land, 0 if end of file or by sea */
  403.  
  404. NODE * PASCAL do_getline(NODE *tree)
  405. {
  406.     auto     NODE      *redir;
  407.     auto     FILE      *fp;
  408.     auto     char      *buf;
  409.     auto     int    c, buflen, cnt;
  410.     auto     NODE     **lhs;
  411.  
  412.     if (tree->rnode)
  413.     fp = deal_redirect(tree->rnode);
  414.     else
  415.     fp = input_file;
  416.  
  417.     if (NULL == fp)
  418.     return(tmp_number(-1.0));
  419.  
  420.     if (NULL == tree->lnode)
  421.     return(tmp_number(inrec(fp) == 0 ? 1.0 : 0.0));
  422.  
  423.     buf = NULL;
  424.     c    = read_a_record(fp, &buf, &buflen, &cnt);
  425.     if (EOF == c)
  426.     {
  427.     free(buf);
  428.     return(tmp_number(0.0));
  429.     }
  430.     lhs  = get_lhs(tree->lnode);
  431.     *lhs = make_string(buf, cnt);
  432.     free(buf);
  433.     do_deref();
  434.     if (tree->lnode && NODE_FIELD_SPEC == tree->lnode->type)
  435.     field_spec_changed(tree->lnode->numbr);
  436.     return(tmp_number(1.0));
  437. }
  438.  
  439.  
  440. NODE * PASCAL do_close(NODE *tree)
  441. {
  442.     register int      i;
  443.     auto     NODE     *tmp;
  444.     auto     int      ret_val = 0;
  445.  
  446.     get_one(tree, &tmp);
  447.     if (tmp == Nnull_string)
  448.     {
  449.     close_redirect_files();
  450.     ret_val = 1;
  451.     }
  452.     else
  453.     {
  454.     tmp = force_string(tmp);
  455.     for (i = 0; i < MAXDIM(reds); ++i)
  456.     {
  457.         if (reds[i].fp && cmp_nodes(reds[i].value, tmp) == 0)
  458.         {
  459.         fclose(reds[i].fp);
  460.         reds[i].fp    = NULL;
  461.         reds[i].flag  = NODE_ILLEGAL;
  462.         ret_val       = 1;
  463.         break;
  464.         }
  465.     }
  466.     }
  467.     return(tmp_number((AWKNUM) ret_val));
  468. }
  469.  
  470.  
  471. NODE * PASCAL do_index(NODE *tree)
  472. {
  473.     register char      *p1, *p2;
  474.     register int       l1, l2;
  475.     auto     NODE      *s1, *s2;
  476.  
  477.     get_two(tree, &s1, &s2);
  478.     p1 = s1->stptr;
  479.     p2 = s2->stptr;
  480.     l1 = s1->stlen;
  481.     l2 = s2->stlen;
  482.     while (l1)
  483.     {
  484.     if (*p1 == *p2)        /* BW: speed up index() */
  485.     {
  486.         if (0 == strncmp(p1, p2, l2))
  487.         return(tmp_number((AWKNUM) (1 + s1->stlen - l1)));
  488.     }
  489.     l1--;
  490.     p1++;
  491.     }
  492.     return(tmp_number(0.0));
  493. }
  494.  
  495.  
  496. NODE * PASCAL do_upper(NODE *tree)
  497. {
  498.     auto     NODE      *tmp;
  499.  
  500.     get_one(tree, &tmp);
  501.     tmp = force_string(tmp);
  502.     strupr(tmp->stptr);
  503.     return(tmp_string(tmp->stptr, tmp->stlen));
  504. }
  505.  
  506.  
  507. NODE * PASCAL do_lower(NODE *tree)
  508. {
  509.     auto     NODE      *tmp;
  510.  
  511.     get_one(tree, &tmp);
  512.     tmp = force_string(tmp);
  513.     strlwr(tmp->stptr);
  514.     return(tmp_string(tmp->stptr, tmp->stlen));
  515. }
  516.  
  517.  
  518. NODE * PASCAL do_reverse(NODE *tree)
  519. {
  520.     auto     NODE      *tmp;
  521.  
  522.     get_one(tree, &tmp);
  523.     tmp = force_string(tmp);
  524.     strrev(tmp->stptr);
  525.     return(tmp_string(tmp->stptr, tmp->stlen));
  526. }
  527.  
  528.  
  529. NODE * PASCAL do_srand(NODE *tree)
  530. {
  531.     auto     NODE      *tmp;
  532.     auto     unsigned    seed;
  533.  
  534.     get_one(tree, &tmp);
  535.     if (tmp == Nnull_string)
  536.     seed = (unsigned) force_number(tmp);
  537.     else
  538.     seed = (unsigned) time(NULL);
  539.     srand(seed);
  540.     return(tmp_number((AWKNUM) 0.0));
  541. }
  542.  
  543.  
  544. NODE * PASCAL do_rand(NODE *tree)
  545. {
  546.     auto     int       r_num;
  547.     auto     AWKNUM    num;
  548.  
  549.     r_num = rand();
  550.     if (0 == r_num)
  551.     num = 0.0;
  552.     else
  553.     {
  554.     while (1 == r_num)
  555.         r_num = rand();
  556.     num = (AWKNUM) 1.0 / (AWKNUM) r_num;
  557.     }
  558.     return(tmp_number(num));
  559. }
  560.  
  561.  
  562. NODE * PASCAL do_int(NODE *tree)
  563. {
  564.     auto     NODE      *tmp;
  565.  
  566.     get_one(tree, &tmp);
  567.     return(tmp_number(floor(force_number(tmp))));
  568. }
  569.  
  570.  
  571. NODE * PASCAL do_length(NODE *tree)
  572. {
  573.     auto     NODE    *tmp;
  574.  
  575.     get_one(tree, &tmp);
  576.     return(tmp_number((AWKNUM) (force_string(tmp)->stlen)));
  577. }
  578.  
  579.  
  580. NODE * PASCAL do_log(NODE *tree)
  581. {
  582.     auto     NODE    *tmp;
  583.  
  584.     get_one(tree, &tmp);
  585.     return(tmp_number(log(force_number(tmp))));
  586. }
  587.  
  588.  
  589. NODE * PASCAL do_printf(NODE *tree)
  590. {
  591.     register FILE    *fp;
  592.  
  593.     fp = deal_redirect(tree->rnode);
  594.     print_simple(do_sprintf(tree->lnode), fp);
  595.     return(Nnull_string);
  596. }
  597.  
  598.  
  599. NODE * PASCAL do_split(NODE *tree)
  600. {
  601.     register REPAT_BUFFER    *splitc;
  602.     register int          num;
  603.     register char         *ptr, *ttmp;
  604.     auto     int          tcnt, pos, new_pos;
  605.     auto     int          len;
  606.     auto     REREGS          reregs;
  607.     auto     NODE         *t1, *t2, *t3;
  608.  
  609.     if (a_get_three(tree, &t1, &t2, &t3) < 3)
  610.     splitc = get_fs();
  611.     else
  612.     {
  613.     if (NODE_REGEXP == t3->type)
  614.     {
  615.         splitc   = t3->rereg;
  616.     }
  617.     else
  618.     {
  619.         t3 = force_string(t3);
  620.         clear_wrk_repat();
  621.         splitc = &wrk_repat;
  622.         ptr = re_compile_pattern(t3->stptr, t3->stlen, splitc);
  623.         if (ptr)
  624.         panic("Invalid REGEXP(%s) in split(): %s", t3->stptr, ptr);
  625.     }
  626.     }
  627.  
  628.     num  = 0;
  629.     tree = force_string(t1);
  630.     ptr  = tree->stptr;
  631.     len  = tree->stlen;
  632.     assoc_clear(t2);
  633.  
  634.     pos = 0;
  635.     do
  636.     {
  637.     new_pos = re_search(splitc, ptr, len, pos, len - pos, &reregs);
  638.     ttmp    = ptr + pos;
  639.     if (new_pos >= 0)
  640.         tcnt = new_pos - pos;
  641.     else
  642.         tcnt = len - pos;
  643.     pos = reregs.end[0];
  644.     *assoc_lookup(t2, make_number((AWKNUM) (++num)), ASSOC_CREATE) =
  645.               make_string(ttmp, tcnt);
  646.     } while (new_pos >= 0);
  647.  
  648.     return(tmp_number((AWKNUM) num));
  649. }
  650.  
  651.  
  652. /* Note that the output buffer cannot be static because sprintf may get called
  653.  * recursively by force_string.  Hence the wasteful malloc calls.
  654.  */
  655.  
  656.  
  657. /* %e and %f formats are not properly implemented.  Someone should fix them */
  658.  
  659. /* BW: %e and %f were not working because "fw" and "prec" were defined as
  660.  *     long rather than int.  This has been fixed.
  661.  */
  662.  
  663. NODE * PASCAL do_sprintf(NODE *tree)
  664. {
  665. #define bchunk(s,l) if(l) {\
  666.     if((l)>ofre) {\
  667.       char *tmp;\
  668.       tmp=(char *)malloc(osiz*2);\
  669.       if (NULL == tmp) panic("Out of memory in bchunk()");\
  670.       memcpy(tmp,obuf,olen);\
  671.       obuf=tmp;\
  672.       ofre+=osiz;\
  673.       osiz*=2;\
  674.     }\
  675.     memcpy(obuf+olen,s,(l));\
  676.     olen+=(l);\
  677.     ofre-=(l);\
  678.   }
  679.  
  680. /* Is there space for something L big in the buffer? */
  681. #define chksize(l)  if((l)>ofre) {\
  682.     char *tmp;\
  683.     tmp=(char *)malloc(osiz*2);\
  684.     if (NULL == tmp) panic("Out of memory in chksize()");\
  685.     memcpy(tmp,obuf,olen);\
  686.     obuf=tmp;\
  687.     ofre+=osiz;\
  688.     osiz*=2;\
  689.   }
  690. /* Get the next arg to be formatted.  If we've run out of args, return
  691.    "" (Null string) */
  692. #define parse_next_arg() {\
  693.   if(!carg) arg= Nnull_string;\
  694.   else {\
  695.       get_one(carg,&arg);\
  696.     carg=carg->rnode;\
  697.   }\
  698.  }
  699.  
  700.     auto     char        *obuf;
  701.     auto     int         osiz, ofre, olen;
  702.     static   char         chbuf[] = "0123456789abcdef";
  703.     static   char        sp[] = " ";
  704.     auto     char        *s0, *s1;
  705.     auto     int         n0;
  706.     auto     NODE        *sfmt, *arg;
  707.     register NODE        *carg;
  708.     auto     int         fw, prec;
  709.     auto     int        *cur;
  710.     auto     long         lj, alt, big;
  711.     auto     long         val;
  712.     auto     unsigned long   uval;
  713.     auto     int         sgn;
  714.     auto     int         base;
  715.     auto     char         cpbuf[30]; /* if we have numbers bigger than 30 */
  716.                     /* chars we lose, but seems unlikely */
  717.     auto     char        *cend = &cpbuf[30];
  718.     auto     char        *cp;
  719.     auto     char        *fill;
  720.     auto     double         tmpval;
  721.     auto     char        *pr_str;
  722.  
  723.     obuf = (char *) malloc(120);
  724.     if (NULL == obuf)
  725.     panic("Out of memory in function do_sprintf()");
  726.     osiz = 120;
  727.     ofre = osiz;
  728.     olen = 0;
  729.     get_one(tree, &sfmt);
  730.     sfmt = force_string(sfmt);
  731.     carg = tree->rnode;
  732.     for (s0 = s1 = sfmt->stptr, n0 = sfmt->stlen; n0-- > 0;)
  733.     {
  734.     if (*s1 != '%')
  735.     {
  736.         s1++;
  737.         continue;
  738.     }
  739.     bchunk(s0, s1 - s0);
  740.     s0   = s1;
  741.     cur  = &fw;
  742.     fw   = 0;
  743.     prec = 0;
  744.     lj   = alt = big = 0;
  745.     fill = sp;
  746.     cp   = cend;
  747.     s1++;
  748.  
  749. retry:
  750.     --n0;
  751.     switch (*s1++)
  752.     {
  753.         case '%':
  754.         bchunk("%", 1);
  755.         s0 = s1;
  756.         break;
  757.         case '0':
  758.         if (fill != sp || lj)
  759.             goto lose;
  760.         fill = "0";             /* FALL through */
  761.         case '1':
  762.         case '2':
  763.         case '3':
  764.         case '4':
  765.         case '5':
  766.         case '6':
  767.         case '7':
  768.         case '8':
  769.         case '9':
  770.         if (cur == 0)
  771.             goto lose;
  772.         *cur = s1[-1] - '0';
  773.         while (n0 > 0 && *s1 >= '0' && *s1 <= '9')
  774.         {
  775.             --n0;
  776.             *cur = *cur * 10 + *s1++ - '0';
  777.         }
  778.         goto retry;
  779.         case '-':
  780.         if (lj || fill != sp)
  781.             goto lose;
  782.         lj++;
  783.         goto retry;
  784.         case '.':
  785.         if (cur != &fw)
  786.             goto lose;
  787.         cur = ≺
  788.         goto retry;
  789.         case '#':
  790.         if (alt)
  791.             goto lose;
  792.         alt++;
  793.         goto retry;
  794.         case 'l':
  795.         if (big)
  796.             goto lose;
  797.         big++;
  798.         goto retry;
  799.         case '*':
  800.         if (cur == 0)
  801.             goto lose;
  802.         parse_next_arg();
  803.         *cur = (int) arg;
  804.         goto retry;
  805.         case 'c':
  806.         parse_next_arg();
  807.         if (arg->type == NODE_NUMBER)
  808.         {
  809.             uval     = (unsigned long) arg->numbr;
  810.             cpbuf[0] = uval;
  811.             prec     = 1;
  812.             pr_str   = cpbuf;
  813.             goto dopr_string;
  814.         }
  815.         if (!prec || prec > arg->stlen)
  816.             prec = arg->stlen;
  817.         pr_str = cpbuf;
  818.         goto dopr_string;
  819.         case 's':
  820.         parse_next_arg();
  821.         arg = force_string(arg);
  822.         if (!prec || prec > arg->stlen)
  823.             prec = arg->stlen;
  824.         pr_str = arg->stptr;
  825.  
  826.     dopr_string:
  827.         if (fw > prec && !lj)
  828.         {
  829.             while (fw > prec)
  830.             {
  831.             bchunk(sp, 1);
  832.             fw--;
  833.             }
  834.         }
  835.         bchunk(pr_str, (int) prec);
  836.         if (fw > prec)
  837.         {
  838.             while (fw > prec)
  839.             {
  840.             bchunk(sp, 1);
  841.             fw--;
  842.             }
  843.         }
  844.         s0 = s1;
  845.         break;
  846.         case 'd':
  847.         parse_next_arg();
  848.         val = (long) force_number(arg);
  849.         if (val < 0)
  850.         {
  851.             sgn = 1;
  852.             val = -val;
  853.         }
  854.         else
  855.             sgn = 0;
  856.         do
  857.         {
  858.             *--cp = '0' + val % 10;
  859.             val /= 10;
  860.         } while (val);
  861.         if (sgn)
  862.             *--cp = '-';
  863.         prec = cend - cp;
  864.         if (fw > prec && !lj)
  865.         {
  866.             if (fill != sp && *cp == '-')
  867.             {
  868.             bchunk(cp, 1);
  869.             cp++;
  870.             prec--;
  871.             fw--;
  872.             }
  873.             while (fw > prec)
  874.             {
  875.             bchunk(fill, 1);
  876.             fw--;
  877.             }
  878.         }
  879.         bchunk(cp, (int) prec);
  880.         if (fw > prec)
  881.         {
  882.             while (fw > prec)
  883.             {
  884.             bchunk(fill, 1);
  885.             fw--;
  886.             }
  887.         }
  888.         s0 = s1;
  889.         break;
  890.         case 'u':
  891.         base = 10;
  892.         goto pr_unsigned;
  893.         case 'o':
  894.         base = 8;
  895.         goto pr_unsigned;
  896.         case 'x':
  897.         base = 16;
  898.         goto pr_unsigned;
  899. pr_unsigned:
  900.         parse_next_arg();
  901.         uval = (unsigned long) force_number(arg);
  902.         do
  903.         {
  904.             *--cp = chbuf[uval % base];
  905.             uval /= base;
  906.         } while (uval);
  907.         prec = cend - cp;
  908.         if (fw > prec && !lj)
  909.         {
  910.             while (fw > prec)
  911.             {
  912.             bchunk(fill, 1);
  913.             fw--;
  914.             }
  915.         }
  916.         bchunk(cp, (int) prec);
  917.         if (fw > prec)
  918.         {
  919.             while (fw > prec)
  920.             {
  921.             bchunk(fill, 1);
  922.             fw--;
  923.             }
  924.         }
  925.         s0 = s1;
  926.         break;
  927.         case 'g':
  928.         parse_next_arg();
  929.         tmpval = force_number(arg);
  930.         if (prec == 0)
  931.             prec = 13;
  932.  
  933.         /** gcvt(tmpval,prec,cpbuf); **//* BW */
  934.         sprintf(cpbuf, "%g", tmpval);    /* BW */
  935.  
  936.         prec = strlen(cpbuf);
  937.         cp = cpbuf;
  938.         if (fw > prec && !lj)
  939.         {
  940.             if (fill != sp && *cp == '-')
  941.             {
  942.             bchunk(cp, 1);
  943.             cp++;
  944.             prec--;
  945.             }        /* Deal with .5 as 0.5 */
  946.             if (fill == sp && *cp == '.')
  947.             {
  948.             --fw;
  949.             while (--fw >= prec)
  950.             {
  951.                 bchunk(fill, 1);
  952.             }
  953.             bchunk("0", 1);
  954.             }
  955.             else
  956.             while (fw-- > prec)
  957.                 bchunk(fill, 1);
  958.         }
  959.         else
  960.         {        /* Turn .5 into 0.5 */
  961.             /* FOO */
  962.             if (*cp == '.' && fill == sp)
  963.             {
  964.             bchunk("0", 1);
  965.             --fw;
  966.             }
  967.         }
  968.         bchunk(cp, (int) prec);
  969.         if (fw > prec)
  970.             while (fw-- > prec)
  971.             bchunk(fill, 1);
  972.         s0 = s1;
  973.         break;
  974.         case 'f':
  975.         parse_next_arg();
  976.         tmpval = force_number(arg);
  977.         chksize(fw + prec + 5);    /* 5==slop */
  978.         cp = cpbuf;
  979.         *cp++ = '%';
  980.         if (lj)
  981.             *cp++ = '-';
  982.         if (fill != sp)
  983.             *cp++ = '0';
  984.         if (prec != 0)
  985.         {
  986.             strcpy(cp, "*.*f");
  987.             sprintf(obuf + olen, cpbuf, fw, prec, tmpval);
  988.         }
  989.         else
  990.         {
  991.             strcpy(cp, "*f");
  992.             sprintf(obuf + olen, cpbuf, fw, tmpval);
  993.         }
  994.         cp = obuf + olen;
  995.         ofre -= strlen(obuf + olen);
  996.         olen += strlen(obuf + olen);    /* There may be nulls */
  997.         s0 = s1;
  998.         break;
  999.         case 'e':
  1000.         parse_next_arg();
  1001.         tmpval = force_number(arg);
  1002.         chksize(fw + prec + 5);    /* 5==slop */
  1003.         cp = cpbuf;
  1004.         *cp++ = '%';
  1005.         if (lj)
  1006.             *cp++ = '-';
  1007.         if (fill != sp)
  1008.             *cp++ = '0';
  1009.         if (prec != 0)
  1010.         {
  1011.             strcpy(cp, "*.*e");
  1012.             sprintf(obuf + olen, cpbuf, fw, prec, (double) tmpval);
  1013.         }
  1014.         else
  1015.         {
  1016.             strcpy(cp, "*e");
  1017.             sprintf(obuf + olen, cpbuf, fw, (double) tmpval);
  1018.         }
  1019.         cp = obuf + olen;
  1020.         ofre -= strlen(obuf + olen);
  1021.         olen += strlen(obuf + olen);    /* There may be nulls */
  1022.         s0 = s1;
  1023.         break;
  1024.         default:
  1025. lose:
  1026.         break;
  1027.     }
  1028.     }
  1029.     bchunk(s0, s1 - s0);
  1030.     sfmt = tmp_string(obuf, olen);
  1031.     free(obuf);
  1032.     return(sfmt);
  1033. }
  1034.  
  1035.  
  1036. NODE * PASCAL do_sqrt(NODE *tree)
  1037. {
  1038.     auto     NODE     *tmp;
  1039.  
  1040.     get_one(tree, &tmp);
  1041.     return(tmp_number(sqrt(force_number(tmp))));
  1042. }
  1043.  
  1044.  
  1045. NODE * PASCAL do_substr(NODE *tree)
  1046. {
  1047.     auto     NODE     *t1, *t2, *t3;
  1048.     register int      n1, n2;
  1049.  
  1050.     if (get_three(tree, &t1, &t2, &t3) < 3)
  1051.     n2 = 32000;
  1052.     else
  1053.     n2 = (int) force_number(t3);
  1054.     n1       = (int) force_number(t2) - 1;
  1055.     tree   = force_string(t1);
  1056.     if (n1 < 0 || n1 >= tree->stlen || n2 <= 0)
  1057.     return(Nnull_string);
  1058.     if (n1 + n2 > tree->stlen)
  1059.     n2 = tree->stlen - n1;
  1060.     return(tmp_string(tree->stptr + n1, n2));
  1061. }
  1062.  
  1063.  
  1064. NODE * PASCAL do_system(NODE *tree)
  1065. {
  1066.     auto     NODE    *tmp;
  1067.     auto     int     ret_val = 0;
  1068.  
  1069.     get_one(tree, &tmp);
  1070.     tmp     = force_string(tmp);
  1071.     if (system(tmp->stptr));
  1072.     ret_val = errno;
  1073.     return(tmp_number((AWKNUM) ret_val));
  1074. }
  1075.  
  1076.  
  1077. /* The print command.  Its name is historical (or hysterical?) */
  1078.  
  1079. VOID PASCAL hack_print_node(NODE *tree)
  1080. {
  1081.     register FILE     *fp;
  1082.  
  1083. #ifndef FAST
  1084.     if (!tree || tree->type != NODE_K_PRINT)
  1085.     panic("Invalid or NULL node passed to hack_print_node()");
  1086. #endif
  1087.  
  1088.     fp = deal_redirect(tree->rnode);
  1089.     tree = tree->lnode;
  1090.     if (!tree)
  1091.     tree = WHOLELINE;
  1092.     if (tree->type != NODE_EXPRESSION_LIST)
  1093.     print_simple(tree, fp);
  1094.     else
  1095.     {
  1096.     while (tree)
  1097.     {
  1098.         print_simple(tree_eval(tree->lnode), fp);
  1099.         tree = tree->rnode;
  1100.         if (tree)
  1101.         print_simple(OFS_node->var_value, fp);
  1102.     }
  1103.     }
  1104.     print_simple(ORS_node->var_value, fp);
  1105.     return;
  1106. }
  1107.  
  1108.  
  1109. /* Get the arguments to functions.  No function cares if you give it
  1110.    too many args (they're ignored).  Only a few fuctions complain
  1111.    about being given too few args.  The rest have defaults */
  1112.  
  1113. VOID PASCAL get_one(NODE *tree, NODE **res)
  1114. {
  1115.     if (!tree)
  1116.     {
  1117.     *res = WHOLELINE;
  1118.     return;
  1119.     }
  1120.  
  1121. #ifndef FAST
  1122.     if (tree->type != NODE_EXPRESSION_LIST)
  1123.     panic("Invalid node type (%d) in get_one()", tree->type);
  1124. #endif
  1125.  
  1126.     *res = tree_eval(tree->lnode);
  1127.     return;
  1128. }
  1129.  
  1130.  
  1131. VOID PASCAL get_two(NODE *tree, NODE **res1, NODE **res2)
  1132. {
  1133.     if (!tree)
  1134.     {
  1135.     *res1 = WHOLELINE;
  1136.     return;
  1137.     }
  1138.  
  1139. #ifndef FAST
  1140.     if (tree->type != NODE_EXPRESSION_LIST)
  1141.     panic("Invalid node1 type (%d) in get_two()", tree->type);
  1142. #endif
  1143.  
  1144.     *res1 = tree_eval(tree->lnode);
  1145.     if (!tree->rnode)
  1146.     return;
  1147.     tree = tree->rnode;
  1148.  
  1149. #ifndef FAST
  1150.     if (tree->type != NODE_EXPRESSION_LIST)
  1151.     panic("Invalid node2 type (%d) in get_two()", tree->type);
  1152. #endif
  1153.  
  1154.     *res2 = tree_eval(tree->lnode);
  1155.     return;
  1156. }
  1157.  
  1158.  
  1159. int PASCAL get_three(NODE *tree, NODE **res1, NODE **res2, NODE **res3)
  1160. {
  1161.     if (!tree)
  1162.     {
  1163.     *res1 = WHOLELINE;
  1164.     return(0);
  1165.     }
  1166.  
  1167. #ifndef FAST
  1168.     if (tree->type != NODE_EXPRESSION_LIST)
  1169.     panic("Invalid node1 type (%d) in get_three()", tree->type);
  1170. #endif
  1171.  
  1172.     *res1 = tree_eval(tree->lnode);
  1173.     if (!tree->rnode)
  1174.     return(1);
  1175.     tree = tree->rnode;
  1176.  
  1177. #ifndef FAST
  1178.     if (tree->type != NODE_EXPRESSION_LIST)
  1179.     panic("Invalid node2 type (%d) in get_three()", tree->type);
  1180. #endif
  1181.  
  1182.     *res2 = tree_eval(tree->lnode);
  1183.     if (!tree->rnode)
  1184.     return(2);
  1185.     tree = tree->rnode;
  1186.  
  1187. #ifndef FAST
  1188.     if (tree->type != NODE_EXPRESSION_LIST)
  1189.     panic("Invalid node3 type (%d) in get_three()", tree->type);
  1190. #endif
  1191.  
  1192.     *res3 = tree_eval(tree->lnode);
  1193.     return(3);
  1194. }
  1195.  
  1196.  
  1197. int PASCAL a_get_three(NODE *tree, NODE **res1, NODE **res2, NODE **res3)
  1198. {
  1199.     if (!tree)
  1200.     {
  1201.     *res1 = WHOLELINE;
  1202.     return(0);
  1203.     }
  1204.  
  1205. #ifndef FAST
  1206.     if (tree->type != NODE_EXPRESSION_LIST)
  1207.     panic("Invalid node1 type (%d) in a_get_three()", tree->type);
  1208. #endif
  1209.  
  1210.     *res1 = tree_eval(tree->lnode);
  1211.     if (!tree->rnode)
  1212.     return(1);
  1213.     tree = tree->rnode;
  1214.  
  1215. #ifndef FAST
  1216.     if (tree->type != NODE_EXPRESSION_LIST)
  1217.     panic("Invalid node2 type (%d) in a_get_three()", tree->type);
  1218. #endif
  1219.  
  1220.     *res2 = tree->lnode;
  1221.     if (!tree->rnode)
  1222.     return(2);
  1223.     tree = tree->rnode;
  1224.  
  1225. #ifndef FAST
  1226.     if (tree->type != NODE_EXPRESSION_LIST)
  1227.     panic("Invalid node3 type (%d) in a_get_three()", tree->type);
  1228. #endif
  1229.  
  1230.     *res3 = tree_eval(tree->lnode);
  1231.     return(3);
  1232. }
  1233.  
  1234.  
  1235. /* FOO this should re-allocate the buffer if it isn't big enough.
  1236.    Also, it should do RMS style only-parse-enough stuff. */
  1237. /* This reads in a line from the input file */
  1238.  
  1239. int PASCAL inrec(FILE *fp)
  1240. {
  1241.     register int      c;
  1242.     static   char    *buf = NULL, *buf_end = NULL;
  1243.     static   int      bsz = 0;
  1244.     auto     int      cnt;
  1245.  
  1246.     if (fp == input_file)
  1247.     ++NR;
  1248.     blank_fields();
  1249.     obstack_free(&other_stack, parse_end);
  1250.  
  1251.     c = read_a_record(fp, &buf, &bsz, &cnt);
  1252.  
  1253.     set_field(0, buf, cnt);
  1254.     if (c == EOF && cnt == 0)
  1255.     {
  1256.     assign_number(&NF_node->var_value, (AWKNUM) 0.0);
  1257.     free(buf);
  1258.     buf = NULL;
  1259.     return(1);
  1260.     }
  1261.  
  1262.     if (fp == input_file)
  1263.     {
  1264.     assign_number(&NR_node->var_value,
  1265.               (AWKNUM) 1.0 + force_number(NR_node->var_value));
  1266.     assign_number(&FNR_node->var_value,
  1267.               (AWKNUM) 1.0 + force_number(FNR_node->var_value));
  1268.     }
  1269.  
  1270.     split_out_fields(FALSE);
  1271.  
  1272.     return(0);
  1273. }
  1274.  
  1275.  
  1276. int PASCAL read_a_record(FILE *fp, char **buf, int *buflen, int *cnt)
  1277. {
  1278.     register char     *cur;
  1279.     register int       c;
  1280.     auto     int       len = 0;
  1281.     auto     int       rs  = get_rs();
  1282.     auto     char     *buf_end;
  1283.  
  1284.     if (!(*buf))
  1285.     {
  1286.     *buf = malloc(80);
  1287.     if (NULL == *buf)
  1288.         panic("Out of memory in function read_a_record()");
  1289.     *buflen = 80;
  1290.     buf_end = *buf + *buflen;
  1291.     }
  1292.  
  1293.     cur     = *buf;
  1294.     buf_end = *buf + *buflen;
  1295.  
  1296.     while ((c = getc(fp)) != EOF)
  1297.     {
  1298.     if (c == rs)
  1299.         break;
  1300.     *cur++ = c;
  1301.     ++len;
  1302.     if (cur == buf_end)
  1303.     {
  1304.         *buf = realloc(*buf, *buflen * 2);
  1305.         if (NULL == *buf)
  1306.         panic("Out of memory in function read_a_record()");
  1307.         cur     = *buf + *buflen;
  1308.         *buflen *= 2;
  1309.         buf_end = *buf + *buflen;
  1310.     }
  1311.     }
  1312.     *cur = EOS;
  1313.     *cnt = len;
  1314.  
  1315. #ifndef FAST
  1316.     if (debugging)
  1317.     printf("Read a record:<%s>\n", buf);
  1318. #endif
  1319.  
  1320.     return(c);
  1321. }
  1322.  
  1323.  
  1324. VOID PASCAL field_spec_changed(AWKNUM fld_no)
  1325. {
  1326.     if ((AWKNUM) 0.0 == fld_no)
  1327.     split_out_fields(TRUE);
  1328.     else
  1329.     fix_fields();
  1330.     return;
  1331. }
  1332.  
  1333.  
  1334. VOID PASCAL split_out_fields(int blank_em)
  1335. {
  1336.     register char          *ttmp;
  1337.     register int           pos, new_pos, max_pos;
  1338.     auto     REPAT_BUFFER     *fs;
  1339.     auto     int           tcnt;
  1340.     auto     REREGS           reregs;
  1341.     auto     NODE          *fld_0_node;
  1342.     static   char          *fld_0_ptr = NULL;
  1343.     static   int           fld_0_len = 0;
  1344.  
  1345.     fs = get_fs();
  1346.     NF = 0;
  1347.  
  1348.     fld_0_node = fields_arr[0];
  1349.     tcnt = fld_0_node->stlen;
  1350.     if (NULL == fld_0_ptr)
  1351.     {
  1352.     fld_0_ptr = malloc(tcnt + 1);
  1353.     fld_0_len = tcnt;
  1354.     }
  1355.     if (fld_0_ptr && fld_0_len < tcnt)
  1356.     {
  1357.     fld_0_ptr = realloc(fld_0_ptr, tcnt + 1);
  1358.     fld_0_len = tcnt;
  1359.     }
  1360.     if (NULL == fld_0_ptr)
  1361.     panic("Out of memory in split_out_fields()");
  1362.     strcpy(fld_0_ptr, fld_0_node->stptr);
  1363.  
  1364.     if (blank_em)
  1365.     {
  1366.     blank_fields();
  1367.     set_field(0, fld_0_ptr, tcnt);
  1368.     }
  1369.  
  1370.     pos     = 0;
  1371.     max_pos = tcnt;
  1372.     do
  1373.     {
  1374.     new_pos = re_search(fs, fld_0_ptr, max_pos, pos,
  1375.                 max_pos - pos, &reregs);
  1376.     ttmp = fld_0_ptr + pos;
  1377.     if (new_pos >= 0)
  1378.         tcnt = new_pos - pos;
  1379.     else
  1380.         tcnt = max_pos - pos;
  1381.     pos  = reregs.end[0];
  1382.     set_field(++NF, ttmp, tcnt);
  1383. #ifndef FAST
  1384.     if (debugging)
  1385.         printf("Split out field %d:<%.*s> Len(%d)\n",
  1386.            NF, tcnt, ttmp, tcnt);
  1387. #endif
  1388.     } while (new_pos >= 0);
  1389.  
  1390.     assign_number(&(NF_node->var_value), (AWKNUM) NF);
  1391.     return;
  1392. }
  1393.  
  1394.  
  1395. /* Redirection for printf and print commands */
  1396.  
  1397. FILE * PASCAL deal_redirect(NODE *tree)
  1398. {
  1399.     register NODE          *tmp;
  1400.     register REDIRECT          *rp;
  1401.     register char          *str;
  1402.     register FILE          *fp;
  1403.     auto     int           tflag;
  1404.  
  1405.     if (!tree)
  1406.     return(stdout);
  1407.     tflag = tree->type;
  1408.     tmp   = tree_eval(tree->subnode);
  1409.     for (rp = reds; rp->flag != 0 && rp < &reds[MAXDIM(reds)]; rp++)
  1410.     {
  1411.     if (rp->flag == tflag && cmp_nodes(rp->value, tmp) == 0)
  1412.         break;
  1413.     }
  1414.     if (rp == &reds[MAXDIM(reds)])
  1415.     {
  1416.     panic("Too many redirections");
  1417.     return(NULL);
  1418.     }
  1419.     if (rp->flag != NODE_ILLEGAL)
  1420.     return(rp->fp);
  1421.     rp->flag  = tflag;
  1422.     rp->value = dupnode(tmp);
  1423.     str       = force_string(tmp)->stptr;
  1424.     switch (tflag)
  1425.     {
  1426.     case NODE_REDIRECT_INPUT:
  1427.         fp = fopen(str, "r");
  1428.         break;
  1429.     case NODE_REDIRECT_OUTPUT:
  1430.         fp = fopen(str, "w");
  1431.         break;
  1432.     case NODE_REDIRECT_APPEND:
  1433.         fp = fopen(str, "a");
  1434.         break;
  1435.     case NODE_REDIRECT_PIPE:
  1436.         fp = NULL;
  1437.         break;
  1438.     }
  1439.     if (fp == NULL)
  1440.     panic("can't redirect to '%s'\n", str);
  1441.     rp->fp = fp;
  1442.     return(fp);
  1443. }
  1444.  
  1445.  
  1446. VOID PASCAL close_redirect_files(void)
  1447. {
  1448.     register int       i;
  1449.  
  1450.     for (i = 0; i < MAXDIM(reds); ++i)
  1451.     {
  1452.     if (reds[i].fp)
  1453.     {
  1454.         fclose(reds[i].fp);
  1455.         reds[i].fp     = NULL;
  1456.         reds[i].flag = 0;
  1457.     }
  1458.     }
  1459.     return;
  1460. }
  1461.  
  1462.  
  1463. VOID PASCAL print_simple(NODE *tree, FILE *fp)
  1464. {
  1465.     tree = force_string(tree);
  1466.     fwrite(tree->stptr, sizeof(char), tree->stlen, fp);
  1467.     return;
  1468. }
  1469.